home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / CLOCK.I < prev    next >
Encoding:
Modula Implementation  |  1990-11-10  |  8.5 KB  |  364 lines
  1. IMPLEMENTATION MODULE Clock; (* V#005 *)
  2. (*$Y+,R-*)
  3.  
  4. FROM SYSTEM IMPORT ASSEMBLER;
  5.  
  6. (*
  7.   06.08.89  TT  Übernahme der DateUtil-Funktionen (V2.00) von Markus Kilbinger
  8.   10.11.90  TT  $L+ bei DateUtil-Funktionen - sollten nun laufen
  9. *)
  10.  
  11. (*
  12. TYPE    Date = RECORD
  13.                  day  : [1..31];
  14.                  month: [1..12];
  15.                  year : CARDINAL
  16.                END;
  17.  
  18.         Time = RECORD
  19.                  second: [0..59];
  20.                  minute: [0..59];
  21.                  hour  : [0..23]
  22.                END;
  23. *)
  24.  
  25. (*$L-*)
  26.  
  27. PROCEDURE PackDate ( d: Date ): CARDINAL;
  28.   BEGIN
  29.     ASSEMBLER
  30.         MOVE    -(A3),D0        ; YEAR
  31.         SUBI    #1980,D0
  32.         BCC     C
  33.         MOVE    (A3),D0
  34.      C: ANDI    #$7F,D0
  35.         LSL     #8,D0
  36.         LSL     #1,D0
  37.         
  38.         MOVE    -(A3),D1        ; MONTH
  39.         ANDI    #$F,D1
  40.         LSL     #5,D1
  41.         
  42.         MOVE    -(A3),D2        ; DAY
  43.         ANDI    #$1F,D2
  44.         
  45.         OR      D1,D0
  46.         OR      D2,D0
  47.         MOVE    D0,(A3)+
  48.     END
  49.   END PackDate;
  50.  
  51. PROCEDURE UnpackDate ( d: CARDINAL ): Date;
  52.   BEGIN
  53.     ASSEMBLER
  54.         MOVE    -(A3),D0
  55.         
  56.         MOVE    D0,D1
  57.         ANDI    #$1F,D1
  58.         MOVE    D1,(A3)+
  59.         
  60.         LSR     #5,D0
  61.         MOVE    D0,D1
  62.         ANDI    #$F,D1
  63.         MOVE    D1,(A3)+
  64.         
  65.         LSR     #4,D0
  66.         ADDI    #1980,D0
  67.         MOVE    D0,(A3)+
  68.     END
  69.   END UnpackDate;
  70.  
  71. PROCEDURE PackTime ( t: Time ): CARDINAL;
  72.   BEGIN
  73.     ASSEMBLER
  74.         MOVE    -(A3),D0        ; HOUR
  75.         ANDI    #$1F,D0
  76.         LSL     #8,D0
  77.         LSL     #3,D0
  78.         
  79.         MOVE    -(A3),D1        ; MINUTE
  80.         ANDI    #$3F,D1
  81.         LSL     #5,D1
  82.         
  83.         MOVE    -(A3),D2        ; SEC
  84.         LSR     #1,D2
  85.         ANDI    #$1F,D2
  86.         
  87.         OR      D1,D0
  88.         OR      D2,D0
  89.         MOVE    D0,(A3)+
  90.     END
  91.   END PackTime;
  92.  
  93. PROCEDURE UnpackTime ( t: CARDINAL ): Time;
  94.   BEGIN
  95.     ASSEMBLER
  96.         MOVE    -(A3),D0
  97.         
  98.         MOVE    D0,D1
  99.         ANDI    #$1F,D1
  100.         LSL     #1,D1
  101.         MOVE    D1,(A3)+
  102.         
  103.         LSR     #5,D0
  104.         MOVE    D0,D1
  105.         ANDI    #$3F,D1
  106.         MOVE    D1,(A3)+
  107.         
  108.         LSR     #6,D0
  109.         MOVE    D0,(A3)+
  110.     END
  111.   END UnpackTime;
  112.  
  113. PROCEDURE CurrentDate (): Date;
  114.   BEGIN
  115.     ASSEMBLER
  116.         MOVE    #$2A,-(A7)
  117.         TRAP    #1
  118.         ADDQ.L  #2,A7
  119.         MOVE    D0,(A3)+
  120.         JMP     UnpackDate
  121.     END
  122.   END CurrentDate;
  123.  
  124. PROCEDURE CurrentTime (): Time;
  125.   BEGIN
  126.     ASSEMBLER
  127.         MOVE    #$2C,-(A7)
  128.         TRAP    #1
  129.         ADDQ.L  #2,A7
  130.         MOVE    D0,(A3)+
  131.         JMP     UnpackTime
  132.     END
  133.   END CurrentTime;
  134.  
  135. PROCEDURE SetDateAndTime ( d: Date; t: Time );
  136.   BEGIN
  137.     ASSEMBLER
  138.         JSR     PackTime
  139.         MOVE    -(A3),-(A7)
  140.         MOVE    #$2D,-(A7)
  141.         TRAP    #1
  142.         ADDQ.L  #2,A7
  143.         
  144.         JSR     PackDate
  145.         MOVE    -(A3),-(A7)
  146.         MOVE    #$2B,-(A7)
  147.         TRAP    #1
  148.         ADDQ.L  #2,A7
  149.         
  150.         MOVE    #22,-(A7)       ; TIME & DATE NOCH AUF STACK
  151.         TRAP    #14
  152.         ADDQ.L  #6,A7
  153.     END
  154.   END SetDateAndTime;
  155.  
  156.  
  157. PROCEDURE GetDateAndTime ( VAR d:Date; VAR t: Time );
  158.   BEGIN
  159.     ASSEMBLER
  160.         MOVE    #23,-(A7)
  161.         TRAP    #14
  162.         ADDQ.L  #2,A7
  163.         MOVE.L  D0,-(A7)
  164.         MOVE.L  -(A3),-(A7)
  165.         MOVE    D0,(A3)+
  166.         JSR     UnpackTime
  167.         MOVE.L  (A7)+,A0
  168.         ADDQ.L  #6,A0
  169.         MOVE.L  -(A3),-(A0)
  170.         MOVE.W  -(A3),-(A0)
  171.         MOVE.L  (A7)+,D0
  172.         SWAP    D0
  173.         MOVE.L  -(A3),-(A7)
  174.         MOVE    D0,(A3)+
  175.         JSR     UnpackDate
  176.         MOVE.L  (A7)+,A0
  177.         ADDQ.L  #6,A0
  178.         MOVE.L  -(A3),-(A0)
  179.         MOVE.W  -(A3),-(A0)
  180.     END
  181.   END GetDateAndTime;
  182.  
  183. (*$L+*)
  184.  
  185.  
  186. CONST
  187.     SYear       =       4;   (* MOD für Schaltjahr.        *)
  188.     Century     =     100;   (* MOD für Jahrhundert.       *)
  189.     SCentury    =     400;   (* MOD für Schaltjahrhundert. *)
  190.     DaysPerWeek =       7;   (* MOD für Wochentag.         *)
  191.     WeekdayOff  =       5;   (* Offset für Wochentag.      *)
  192.     January     =       1;   (* Nr. vom Januar.            *)
  193.     February    =       2;   (* Nr. vom Februar.           *)
  194.     March       =       3;   (* Nr. vom März.              *)
  195.     December    =      12;   (* Nr. vom Dezember.          *)
  196.     DaysPerYear =    365L;   (* Tage pro Jahr.             *)
  197.     Dividend    =    400L;   (* kgV von 4, 100, 400.       *)
  198.     Divisor     = 146097L;   (* 400 * 365 + 100 - 4 + 1.   *)
  199.  
  200. VAR off : ARRAY [January..December] OF INTEGER;   (* Offsets der Monate. *)
  201.  
  202.  
  203. PROCEDURE IsSYear (y : CARDINAL) : BOOLEAN;
  204. (* Testet, ob 'y' ein Schaltjahr ist unter Berücksichtigung des
  205.    gregorianischen Kalenders: Jahre, die mit zwei Nullen enden, sind nur
  206.    dann ein Schaltjahr, wenn sie durch 400 teilbar sind. *)
  207.   (*$L-*)
  208.   BEGIN
  209.     ASSEMBLER
  210.         MOVEQ   #0,D0
  211.         MOVE.W  -(A3),D0
  212.         MOVE    D0,D1
  213.         ANDI    #3,D1
  214.         BNE     no
  215.         MOVE.L  D0,D1
  216.         DIVU    #100,D1
  217.         SWAP    D1
  218.         TST.W   D1
  219.         BNE     yes
  220.         DIVU    #400,D0
  221.         SWAP    D0
  222.         TST.W   D0
  223.         BNE     no
  224.     yes MOVE    #1,(A3)+
  225.         RTS
  226.      no CLR     (A3)+
  227.     END
  228.   END IsSYear;
  229.   (*$L=*)
  230.   
  231.   
  232. PROCEDURE DayOfWeek (d : Date) : WeekDays;
  233.   VAR w: INTEGER;
  234.   BEGIN
  235.     WITH d DO
  236.       w := year + (year DIV SYear) - (year DIV Century) +
  237.            (year DIV SCentury) + off [month] + INTEGER(day) + WeekdayOff;
  238.       IF (IsSYear (year) AND (month < March)) THEN
  239.         DEC (w);
  240.       END;
  241.     END;
  242.     w := w MOD DaysPerWeek;
  243.     RETURN WeekDays (w);
  244.   END DayOfWeek;
  245.   
  246.   
  247. PROCEDURE YearFac (y : CARDINAL) : LONGINT;
  248. (* Berechnet den Teil des 'Factor', der durch das Jahr 'y' bedingt ist. *)
  249.   (*$L-*)
  250.   BEGIN
  251.     ASSEMBLER
  252.         ; RETURN (LONG (y) * DaysPerYear + LONG ((y DIV SYear) -
  253.         ; (y DIV Century) + (y DIV SCentury)));
  254.         MOVEQ   #0,D0
  255.         MOVE    -(A3),D0
  256.         MOVE    D0,D1
  257.         MULU    #365,D1
  258.         MOVE.L  D0,D2
  259.         LSR.L   #2,D2
  260.         ADD.L   D2,D1
  261.         MOVE.L  D1,A0
  262.         MOVE.L  D0,D2
  263.         DIVU    #100,D2
  264.         SUBA.W  D2,A0
  265.         DIVU    #400,D0
  266.         ADDA.W  D0,A0
  267.         MOVE.L  A0,(A3)+
  268.     END
  269.   END YearFac;
  270.   (*$L=*)
  271.   
  272.   
  273. PROCEDURE Factor (d : Date) : LONGINT;
  274. (* Berechnet die Anzahl der Tage zu einem fiktiven Datum für Tag-Differenz. *)
  275.   VAR f : LONGINT;
  276.   BEGIN
  277.     WITH d DO
  278.       f := YearFac (year) + LONG (off [month] + INTEGER(day));
  279.       IF (IsSYear (year) AND (month < March)) THEN
  280.         DEC (f);
  281.       END;
  282.     END;
  283.     RETURN f;
  284.   END Factor;
  285.   
  286.   
  287. PROCEDURE DaysBetween (d1, d2 : Date) : LONGINT;
  288.   BEGIN
  289.     RETURN (Factor (d2) - Factor (d1));
  290.   END DaysBetween;
  291.  
  292.  
  293. PROCEDURE UnFactor (f : LONGINT) : Date;
  294. (* Wandelt eine mit 'Factor' erzeugt Anzahl 'f' von Tagen in ein Datum um. *)
  295.  
  296.   VAR
  297.     g : LONGINT;
  298.     d : Date;
  299.     s : INTEGER;
  300.     i : CARDINAL;
  301.  
  302.   BEGIN
  303.     WITH d DO
  304.       year := SHORT (((f - 1L) * Dividend) DIV Divisor);
  305.       g    := YearFac (year);
  306.       
  307.       IF ((f - g) > DaysPerYear) THEN
  308.         INC (year);
  309.         g := YearFac (year);
  310.       END;
  311.       s := SHORT (f - g);
  312.       
  313.       IF (IsSYear (year) AND (s <= off [March])) THEN
  314.         INC (s);
  315.         
  316.         IF (s > off [February]) THEN
  317.           month := February;
  318.           DEC (s, off [February]);
  319.         ELSE
  320.           month := January;
  321.         END;
  322.       ELSE
  323.         i := December;
  324.         
  325.         WHILE (i >= January) DO
  326.           month := i;
  327.           
  328.           IF (s > off [i]) THEN
  329.             i := January;
  330.           END;
  331.           DEC (i);
  332.         END;
  333.         DEC (s, off [month]);
  334.       END;
  335.       day := s;
  336.     END;
  337.     RETURN d;
  338.   END UnFactor;
  339.  
  340.  
  341. PROCEDURE DaysAdded (d : Date; n : LONGINT) : Date;
  342.   BEGIN
  343.     RETURN UnFactor (Factor (d) + n);
  344.   END DaysAdded;
  345.   
  346.   
  347. BEGIN
  348.   ASSEMBLER
  349.         LEA     off,A0
  350.         CLR.W   (A0)+
  351.         MOVE.W  #31,(A0)+    (* + 31 *)
  352.         MOVE.W  #59,(A0)+    (* + 28 *)
  353.         MOVE.W  #90,(A0)+    (* + 31 *)
  354.         MOVE.W  #120,(A0)+   (* + 30 *)
  355.         MOVE.W  #151,(A0)+   (* + 31 *)
  356.         MOVE.W  #181,(A0)+   (* + 30 *)
  357.         MOVE.W  #212,(A0)+   (* + 31 *)
  358.         MOVE.W  #243,(A0)+   (* + 31 *)
  359.         MOVE.W  #273,(A0)+   (* + 30 *)
  360.         MOVE.W  #304,(A0)+   (* + 31 *)
  361.         MOVE.W  #334,(A0)    (* + 30 *)
  362.   END;
  363. END Clock.
  364.